home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / TOOLPAS2 / FINDERR.PAS < prev    next >
Pascal/Delphi Source File  |  1991-09-17  |  4KB  |  178 lines
  1.  
  2. (*
  3.  * finderr - find tp4.0 error message and call up Q to edit the
  4.  *           specified line.
  5.  *
  6.  * usage:    tpc file >err
  7.  *           type err
  8.  *           finderr >temp.bat
  9.  *           temp
  10.  *
  11.  * S.H.Smith, 30-Dec-87 (17-Sep-91)
  12.  *
  13.  *)
  14.  
  15. var
  16.    fd:          text;
  17.    buf:         string;
  18.    pbuf:        string;
  19.    pfile:       string;
  20.  
  21.  
  22.    procedure getbuf;
  23.       {get next line from file; detects <cr> alone as line delimiter}
  24.    var 
  25.       i: integer;
  26.       c: char;
  27.    begin
  28.       buf := '';
  29.       repeat
  30.          if eof(fd) then
  31.             c := ^Z
  32.          else
  33.             read(fd,c);
  34.          if (c >= ' ') then
  35.             buf := buf + c;
  36.       until (c = ^M) or (c = ^Z);
  37.  
  38.       if c = ^Z then
  39.          buf := ^Z;
  40.    end;
  41.  
  42.  
  43.    procedure found_error;
  44.       {found an error message; format editing commads into script}
  45.    var
  46.       i:        integer;
  47.       col:      integer;
  48.       name:     string;
  49.       line:     string;
  50.    begin
  51.  
  52.       i := pos('(',buf);
  53.       name := copy(buf,1,i-1);
  54.       if (i > 0) and (pos(' ',name) = 0) then
  55.       begin
  56.          pbuf := buf;
  57.  
  58.          getbuf;   {error text}
  59.          getbuf;   {.....^}
  60.          col := pos('^',buf);
  61.  
  62.          writeln('echo.');
  63.          writeln('pause');
  64.  
  65.          {jump to the proper line}
  66.          delete(pbuf,1,i);
  67.          i := pos(')',pbuf);
  68.          line := copy(pbuf,1,i-1);
  69.  
  70. (*****************
  71.          write('keyahead ^J',line,'^M');
  72.          if line > '30' then
  73.             write('^W^W^W^W^W^W^W^W^W^W');
  74.  
  75.          {move cursor out to error column; use tabs first because
  76.           of the 128 character line length limit}
  77.          if col > 8 then
  78.          begin
  79.             write('^V');
  80.             while col > 8 do
  81.             begin
  82.                write('^I');
  83.                dec(col,8);
  84.             end;
  85.             write('^V');
  86.          end;
  87.  
  88.          while col > 1 do
  89.          begin
  90.             write('^D');
  91.             dec(col);
  92.          end;
  93.  
  94.          {load the error file}
  95.          write('^K^E',paramstr(1),'^M');
  96.  
  97.          {load the outer file, if present}
  98.          if pfile <> '' then
  99.          begin
  100.             i := pos('(',pfile);
  101.             write('^K^E',copy(pfile,1,i-1),'^M');
  102.             delete(pfile,1,i);
  103.  
  104.             i := pos(')',pfile);
  105.             line := copy(pfile,1,i-1);
  106.             if line <> '0' then
  107.             begin
  108.                write('^J',line,'^M');
  109.                if line > '30' then
  110.                   write('^W^W^W^W^W^W^W^W^W^W');
  111.             end;
  112.          end;
  113.  
  114.          writeln('^K^N');
  115.          writeln('q ',name);
  116. ************************)
  117.  
  118.          write('q ',name,' ',paramstr(1));
  119.  
  120.          {load the outer file, if present}
  121.          if pfile <> '' then
  122.          begin
  123.             i := pos('(',pfile);
  124.             write(' ',copy(pfile,1,i-1));
  125.          end;
  126.  
  127.          writeln(' -N',line);
  128.       end;
  129.    end;
  130.  
  131.  
  132. begin
  133.    if paramcount <> 1 then
  134.    begin
  135.       writeln('usage:  finderr ERRORFILE >script');
  136.       writeln;
  137.       writeln('example:');
  138.       writeln('  tpc file /m >err');
  139.       writeln('  finderr err >fix.bat');
  140.       writeln('  fix');
  141.       writeln;
  142.       writeln('use with Qedit 2.15 or newer');
  143.       halt(99);
  144.    end;
  145.  
  146.    assign(fd,paramstr(1));
  147.    {$i-} reset(fd); {$i+}
  148.    if ioresult <> 0 then
  149.    begin
  150.       writeln('echo finderr: can''t open ',paramstr(1));
  151.       halt;
  152.    end;
  153.  
  154.    pfile := '';
  155.    pbuf := '';
  156.    getbuf;
  157.  
  158.    while buf <> ^Z do
  159.    begin
  160.       if pos('(0)',buf) > 0 then
  161.          pfile := pbuf;
  162.  
  163.       if pos(':',buf)   > 0 then
  164.       begin
  165.          found_error;
  166.          close(fd);
  167.          halt(0);
  168.       end;
  169.  
  170.       pbuf := buf;
  171.       getbuf;
  172.    end;
  173.  
  174.    close(fd);
  175. end.
  176.  
  177.  
  178.